home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pibcat.zip / PIBCATA.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-01  |  14KB  |  307 lines
  1. (*----------------------------------------------------------------------*)
  2. (*     Display_Archive_Contents --- Display contents of archive file    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Archive_Contents( ArcFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Archive_Contents                               *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of an archive (.ARC file)            *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Archive_Contents( ArcFileName : AnyStr );              *)
  16. (*                                                                      *)
  17. (*          ArcFileName --- name of archive file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*          Dir_Convert_Date_And_Time                                   *)
  23. (*          Start_Library_Listing                                       *)
  24. (*          End_Library_Listing                                         *)
  25. (*          Display_Page_Titles                                         *)
  26. (*          Entry_Matches                                               *)
  27. (*                                                                      *)
  28. (*----------------------------------------------------------------------*)
  29.  
  30. (*----------------------------------------------------------------------*)
  31. (*                  Map of Archive file entry header                    *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. TYPE
  35.    FNameType = ARRAY[1..13] OF CHAR;
  36.  
  37.    Archive_Entry_Type = RECORD
  38.                            Marker   : BYTE      (* Flags beginning of entry *);
  39.                            Version  : BYTE      (* Compression method       *);
  40.                            FileName : FNameType (* file and extension       *);
  41.                            Size     : LONGINT   (* Compressed size          *);
  42.                            Date     : WORD      (* Packed date              *);
  43.                            Time     : WORD      (* Packed time              *);
  44.                            CRC      : WORD      (* Cyclic Redundancy Check  *);
  45.                            OLength  : LONGINT   (* Original length          *);
  46.                         END;
  47.  
  48. CONST
  49.    Archive_Header_Length = 29      (* Length of an archive header entry *);
  50.    Archive_Marker        = 26      (* Marks start of an archive header  *);
  51.    Max_Subdirs           = 20      (* Maximum number of nested subdirs  *);
  52.  
  53. VAR
  54.    ArcFile       : FILE                 (* Archive file to be read        *);
  55.    Archive_Entry : Archive_Entry_Type   (* Header for one file in archive *);
  56.    Archive_Pos   : LONGINT              (* Current byte offset in archive *);
  57.    Bytes_Read    : INTEGER              (* # bytes read from archive file *);
  58.    Ierr          : INTEGER              (* Error flag                     *);
  59.  
  60.                                         (* Nested directory names in      *)
  61.                                         (* archive                        *)
  62.  
  63.    Subdir_Names  : ARRAY[1..Max_Subdirs] OF STRING[13];
  64.  
  65.    Subdir_Depth  : INTEGER              (* Current subdirectory in archive*);
  66.  
  67.    Display_Entry : BOOLEAN              (* TRUE to display this entry *);
  68.    Long_Name     : AnyStr               (* Long file name             *);
  69.    DirS          : DirStr               (* Directory name                 *);
  70.    FExt          : ExtStr               (* Extension of file name         *);
  71.  
  72. (*----------------------------------------------------------------------*)
  73. (*   Get_Next_Archive_Entry --- Get next header entry in archive        *)
  74. (*----------------------------------------------------------------------*)
  75.  
  76. FUNCTION Get_Next_Archive_Entry( VAR ArcEntry      : Archive_Entry_Type;
  77.                                  VAR Display_Entry : BOOLEAN;
  78.                                  VAR Error         : INTEGER ) : BOOLEAN;
  79.  
  80. (*----------------------------------------------------------------------*)
  81. (*                                                                      *)
  82. (*    Function:  Get_Next_Archive_Entry                                 *)
  83. (*                                                                      *)
  84. (*    Purpose:   Gets header information for next file in archive       *)
  85. (*                                                                      *)
  86. (*    Calling sequence:                                                 *)
  87. (*                                                                      *)
  88. (*       OK := Get_Next_Archive_Entry( VAR ArcEntry :                   *)
  89. (*                                         Archive_Entry_Type;          *)
  90. (*                                     VAR Display_Entry : BOOLEAN;     *)
  91. (*                                     VAR Error    : INTEGER ) :       *)
  92. (*                                     BOOLEAN;                         *)
  93. (*                                                                      *)
  94. (*          ArcEntry      --- Header data for next file in archive      *)
  95. (*          Display_Entry --- TRUE to display this entry                *)
  96. (*          Error         --- Error flag                                *)
  97. (*          OK            --- TRUE if header successfully found         *)
  98. (*                                                                      *)
  99. (*----------------------------------------------------------------------*)
  100.  
  101. BEGIN (* Get_Next_Archive_Entry *)
  102.                                    (* Assume no error to start *)
  103.    Error := 0;
  104.                                    (* Assume we don't display this   *)
  105.                                    (* entry.                         *)
  106.    Display_Entry := FALSE;
  107.                                    (* Except first time, move to     *)
  108.                                    (* next supposed header record in *)
  109.                                    (* archive.                       *)
  110.  
  111.    IF ( Archive_Pos <> 0 ) THEN
  112.       Seek( ArcFile, Archive_Pos );
  113.  
  114.                                    (* Read in the file header entry. *)
  115.  
  116.    BlockRead( ArcFile, ArcEntry, Archive_Header_Length, Bytes_Read );
  117.    Error := 0;
  118.                                    (* If wrong size read, or header marker *)
  119.                                    (* byte is incorrect, report archive    *)
  120.                                    (* format error.                        *)
  121.  
  122.    IF ( ( Bytes_Read < 2                    ) OR
  123.         ( ArcEntry.Marker <> Archive_Marker ) ) THEN
  124.       Error := Format_Error
  125.    ELSE                            (* Header looks ok -- figure out *)
  126.                                    (* whaty kind of header it is.   *)
  127.       WITH ArcEntry DO
  128.          CASE Version OF
  129.                                    (* End of archive marker *)
  130.  
  131.             0       : Error := End_Of_File;
  132.  
  133.                                    (* Compressed file *)
  134.  
  135.             1 .. 19 : BEGIN
  136.                                    (* Get position of next archive header *)
  137.  
  138.                          IF ( Bytes_Read < Archive_Header_Length ) THEN
  139.                             Error := Format_Error
  140.                          ELSE
  141.                             BEGIN
  142.  
  143.                                Archive_Pos := Archive_Pos + Size +
  144.                                               Archive_Header_Length;
  145.  
  146.                                    (* Adjust for older archives *)
  147.  
  148.                                IF ( Version = 1 ) THEN
  149.                                   BEGIN
  150.                                      OLength := Size;
  151.                                      Version := 2;
  152.                                      DEC( Archive_Pos , 2 );
  153.                                   END;
  154.  
  155.                                    (* Display this entry *)
  156.  
  157.                                Display_Entry := TRUE;
  158.  
  159.                             END;
  160.  
  161.                       END;
  162.  
  163.             30      : BEGIN        (* Subdirectory begins *)
  164.  
  165.                                    (* If there is room, add this *)
  166.                                    (* subdirectory to current    *)
  167.                                    (* nesting list.              *)
  168.  
  169.                          IF ( Bytes_Read < Archive_Header_Length ) THEN
  170.                             Error := Format_Error
  171.                          ELSE IF ( Subdir_Depth < Max_Subdirs ) THEN
  172.                             BEGIN
  173.  
  174.                                INC( Subdir_Depth );
  175.  
  176.                                Subdir_Names[ Subdir_Depth ] :=
  177.                                   COPY( FileName, 1,
  178.                                         PRED( POS( #0 , FileName ) ) );
  179.  
  180.                             END
  181.                          ELSE
  182.                             Error := Too_Many_Subs;
  183.  
  184.                          Archive_Pos := Archive_Pos + Archive_Header_Length;
  185.  
  186.                       END;
  187.  
  188.             31      : BEGIN        (* End of subdirectory *)
  189.  
  190.                                    (* Remove this subdirectory from *)
  191.                                    (* current nesting               *)
  192.  
  193.                          IF ( Subdir_Depth > 0 ) THEN
  194.                             DEC( Subdir_Depth );
  195.  
  196.                                    (* Position past header          *)
  197.  
  198.                          Archive_Pos := Archive_Pos + 2;
  199.  
  200.                       END;
  201.  
  202.             ELSE                      (* Skip over other header types  *)
  203.  
  204.                       IF ( Bytes_Read < Archive_Header_Length ) THEN
  205.                          Error := Format_Error
  206.                       ELSE
  207.                          Archive_Pos := Archive_Pos + Size +
  208.                                         Archive_Header_Length;
  209.  
  210.          END (* CASE *);
  211.                                     (* Report success/failure to calling *)
  212.                                     (* routine.                          *)
  213.  
  214.    Get_Next_Archive_Entry := ( Error = 0 );
  215.  
  216. END   (* Get_Next_Archive_Entry *);
  217.  
  218. (*----------------------------------------------------------------------*)
  219. (*      Display_Archive_Entry --- Display archive file entry info       *)
  220. (*----------------------------------------------------------------------*)
  221.  
  222. PROCEDURE Display_Archive_Entry( Archive_Entry : Archive_Entry_Type );
  223.  
  224. VAR
  225.    I          : INTEGER;
  226.    FName      : AnyStr;
  227.    TimeDate   : LONGINT;
  228.    TimeDateW  : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  229.  
  230. BEGIN (* Display_Archive_Entry *)
  231.  
  232.    WITH Archive_Entry DO
  233.       BEGIN
  234.                                    (* Pick up file name *)
  235.  
  236.          FName    := COPY( FileName, 1, PRED( POS( #0 , FileName ) ) );
  237.  
  238.                                    (* See if this file matches the   *)
  239.                                    (* entry spec wildcard.  Exit if  *)
  240.                                    (* not.                           *)
  241.          IF Use_Entry_Spec THEN
  242.             IF ( NOT Entry_Matches( FName ) ) THEN
  243.                EXIT;
  244.                                    (* Get date and time of creation *)
  245.          TimeDateW[ 1 ] := Time;
  246.          TimeDateW[ 2 ] := Date;
  247.                                    (* See if we're to write out *)
  248.                                    (* long file names.  If so,  *)
  249.                                    (* get subdirectory path     *)
  250.                                    (* followed by file name.    *)
  251.          Long_Name := '';
  252.  
  253.          IF Show_Long_File_Names THEN
  254.             IF ( Subdir_Depth > 0 ) THEN
  255.                BEGIN
  256.  
  257.                   FOR I := 1 TO Subdir_Depth DO
  258.                      Long_Name := Long_Name + Subdir_Names[ I ] + '\';
  259.  
  260.                   Long_Name := Long_Name + FName;
  261.  
  262.                END;
  263.                                    (* Display info for this entry *)
  264.  
  265.          Display_One_Entry( FName, Olength, TimeDate, ArcFileName,
  266.                             Current_Subdirectory, Long_Name );
  267.  
  268.       END;
  269.  
  270. END (* Display_Archive_Entry *);
  271.  
  272. (*----------------------------------------------------------------------*)
  273.  
  274. BEGIN (* Display_Archive_Contents *)
  275.  
  276.                                    (* Note if LZH or LZS type.         *)
  277.  
  278.    FSplit( ArcFileName, DirS, Long_Name, FExt );
  279.  
  280.    IF ( LENGTH( FExt ) > 1 ) THEN
  281.       IF ( FExt[ 1 ] = '.' ) THEN
  282.          DELETE( FExt, 1, 1 );
  283.  
  284.                                    (* Open archive file and initialize *)
  285.                                    (* contents display.                *)
  286.  
  287.    IF Start_Contents_Listing( ' ' + FExt + ' file: ',
  288.                               Current_Subdirectory + ArcFileName, ArcFile,
  289.                               Archive_Pos, Ierr ) THEN
  290.       BEGIN
  291.                                    (* No subdirectories yet encountered *)
  292.                                    (* in archive file                   *)
  293.          Subdir_Depth := 0;
  294.                                    (* Loop over entries in archive file *)
  295.  
  296.          WHILE( Get_Next_Archive_Entry( Archive_Entry , Display_Entry , Ierr ) ) DO
  297.             IF Display_Entry THEN
  298.                Display_Archive_Entry( Archive_Entry );
  299.  
  300.                                    (* Close library files, complete display *)
  301.  
  302.          End_Contents_Listing( ArcFile , Ierr );
  303.  
  304.       END;
  305.  
  306. END   (* Display_Archive_Contents *);
  307.